COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 A ACWPRV PDLEN S%FIN2 S%TIMW DEVNAM DEVSER STATE GTIMER IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2
C00009 ENDMK
C⊗;
;⊗ A ACWPRV PDLEN S%FIN2 S%TIMW DEVNAM DEVSER STATE GTIMER IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2

	TITLE CLRIMP

;Program to clear away hanging IMP DDBs "cleanly" by changing the state
;to Time Wait and setting a timer.  This ensures that the DDBFls routine
;will be called and release all free storage pointed to by this DDB.

A←←1 ↔ B←←2 ↔ DDB←←3 ↔ P←←17

ACWPRV←←40		;LH priv bit
PDLEN←←20
S%FIN2←←=7		;State we want to get out of
S%TIMW←←=9		;State we want to get into

;IMP DDB words, with AC field set for indirect access
DEVNAM:	0(DDB)
DEVSER:	3(DDB)
STATE:	(DDB)			;To be filled in with .SYMLed value
GTIMER:	(DDB)			;To be filled in with .SYMLed value

;Other storage
IMPDDB:	0			;Address of model IMP DDB
SYSTOP:	0			;Start of system free storage
SYSREL:	0			;Relocation for system core
DDBSAV:	0			;Address of current DDB
CONFRM:	0			;Whether to confirm each DDB
NUMBAD:	0			;Number of bad DDBs found
NUMCLR:	0			;Number cleared
PDL:	BLOCK PDLEN

CLRIMP:	RESET
	SETZM NUMBAD
	SETZM NUMCLR
	MOVE P,[IOWD PDLEN,PDL]
	MOVSI A,1
	GETPRV A,		;Get passive privs
	TLNN A,ACWPRV		;Can this guy write core?
	 JRST [ OUTSTR [ASCIZ/Sorry, only wizards can run this program./]
		EXIT]
	MOVSI A,ACWPRV
	SETPRV A,		;Enable
	MOVEI A,[RADIX50 0,IMPDDB ↔ 0]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for IMPDDB./]
		EXIT]
	MOVEM A,IMPDDB
	MOVEI A,[RADIX50 0,STATE ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for STATE./]
		EXIT]
	HRRM A,STATE
	MOVEI A,[RADIX50 0,GTIMER ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for GTIMER./]
		EXIT]
	HRRM A,GTIMER
	MOVEI A,265
	PEEK A,			;Get SYSTOP
	PEEK A,
	TRZ A,1777		;Make sure it's a 1K boundary
	CAILE A,400000		;Not beyond 400000, though
	 MOVEI A,400000
	MOVEM A,SYSTOP
	MOVEI B,400000		;Compute relocation for later offsets
	SUB B,A
	MOVEM B,SYSREL
	MOVE B,A
	ADDI B,377776		;Get as much as possible, writeable
	HRL A,B
	SETPR2 A,		;Map system into upper segment
	 JRST [ OUTSTR [ASCIZ/SETPR2 lost./]
		EXIT]
	SETOM CONFRM		;Assume yes
	OUTSTR [ASCIZ/Do you want to confirm each DDB being cleared? /]
	PUSHJ P,YESNO
	SETZM CONFRM		;No

	MOVE A,IMPDDB
	ADD A,DEVSER
	HRRZ A,A
	PEEK A,
	HLRZ DDB,A		;Address of first IMP DDB
LOOP:	MOVEM DDB,DDBSAV	;Save before relocating
	ADD DDB,SYSREL		;Relocate to upper segment
	HLRZ A,@DEVNAM		;Get device name
	CAIE A,'IMP'		;Is it an IMP?
	 JRST ALLDON		;No
	SKIPL A,@STATE		;Get connection's TCP state, skip if error
	CAIN A,S%FIN2		;In the losing state?
	CAIA			;Skip if candidate for clearing
	JRST NXTIMP		;No
	AOS NUMBAD		;Count them
	SKIPN CONFRM		;Does he want to confirm?
	 JRST CLRONE		;No
	OUTSTR [ASCIZ/IMP DDB at /]
	MOVE A,DDBSAV
	PUSHJ P,OCTOUT		;Clobbers A and B
	MOVEI A,[ASCIZ/ in error state.  Clear it? /]
	SKIPL @STATE
	MOVEI A,[ASCIZ/ in state Fin2.  Clear it? /]
	OUTSTR (A)
	PUSHJ P,YESNO
	 JRST NXTIMP		;No
CLRONE:	AOS NUMCLR		;Count number cleared
	MOVEI A,1		;Set timer
	MOVEM A,@GTIMER
	MOVEI A,S%TIMW		;Set new state
	MOVEM A,@STATE
NXTIMP:	HLRZ DDB,@DEVSER	;Get next DDB
	CAML DDB,SYSTOP		;Make sure it's in free storage
	 JRST LOOP
ALLDON:	MOVE A,NUMBAD
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ bad DDBs found, /]
	MOVE A,NUMCLR
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ cleared./]
	EXIT

OCTOUT:	IDIVI A,10
	PUSH P,B
	JUMPE A,OCTOU1
	PUSHJ P,OCTOUT
OCTOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

DECOUT:	IDIVI A,=10
	PUSH P,B
	JUMPE A,DECOU1
	PUSHJ P,DECOUT
DECOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

;Get Yes-or-no response; skip if Yes.
YESNO:	INCHRW A
	CAIN A,15		;<cr>?
	 JRST [ INCHRW A	;Yes, eat <lf>
		JRST YESNO2]
	CAIE A,"Y"
	CAIN A,"y"
	CAIA
	JRST YESNO1
	OUTSTR [ASCIZ/es.
/]
CPOPJ1:	AOS (P)
CPOPJ:	POPJ P,

YESNO1:	CAIE A,"N"
	CAIN A,"n"
	CAIA
	JRST YESNO2
	OUTSTR [ASCIZ/o.
/]
	POPJ P,

YESNO2:	OUTSTR [ASCIZ/
Please type Y or N: /]
	JRST YESNO

	END CLRIMP